The CICA Windows Explosion!/The CICA Windows Explosion! - Disc 2.iso/misc/mf-db.zip/VBSAMPLE\BCARDS.FRM

Text File | 1993-11-17 | 42KB | 1,289 lines

VERSION 2.00
Begin Form bcard
   BackColor       =   &H00C0C0C0&
   Caption         =   "Business Cards"
   ClientHeight    =   4755
   ClientLeft      =   915
   ClientTop       =   1680
   ClientWidth     =   5475
   Height          =   5415
   Left            =   870
   LinkTopic       =   "Form3"
   ScaleHeight     =   4755
   ScaleWidth      =   5475
   Top             =   1065
   Width           =   5565
   Begin Frame gBox
      BackColor       =   &H00C0C0C0&
      Enabled         =   0   'False
      Height          =   4695
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   5355
      Begin ComboBox Combo1
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   300
         Left            =   3180
         Style           =   2  'Dropdown List
         TabIndex        =   10
         Top             =   2940
         Width           =   1995
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   0
         Left            =   180
         TabIndex        =   1
         Top             =   780
         Width           =   2115
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   1
         Left            =   2340
         TabIndex        =   2
         Top             =   780
         Width           =   2835
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   2
         Left            =   180
         TabIndex        =   4
         Top             =   1860
         Width           =   4995
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   3
         Left            =   180
         TabIndex        =   5
         Top             =   2400
         Width           =   2595
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   4
         Left            =   2880
         TabIndex        =   6
         Top             =   2400
         Width           =   435
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   5
         Left            =   3660
         TabIndex        =   7
         Top             =   2400
         Width           =   1515
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   6
         Left            =   180
         TabIndex        =   3
         Top             =   1320
         Width           =   4995
      End
      Begin CommandButton Command1
         Caption         =   "&Next Card"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Index           =   0
         Left            =   120
         TabIndex        =   13
         Top             =   4140
         Width           =   1695
      End
      Begin CommandButton Command1
         Caption         =   "&Previous Card"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Index           =   1
         Left            =   120
         TabIndex        =   12
         Top             =   3780
         Width           =   1695
      End
      Begin CommandButton Command2
         Caption         =   "&Find Card"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Left            =   120
         TabIndex        =   11
         Top             =   3420
         Width           =   3315
      End
      Begin CommandButton Command3
         Caption         =   "New &Card"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Left            =   1800
         TabIndex        =   14
         Top             =   3780
         Width           =   1635
      End
      Begin Frame Frame1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Order by"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   1155
         Left            =   3660
         TabIndex        =   19
         Top             =   3360
         Width           =   1515
         Begin OptionButton Option1
            BackColor       =   &H00C0C0C0&
            Caption         =   "Reference"
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Index           =   2
            Left            =   180
            TabIndex        =   18
            Top             =   780
            Width           =   1215
         End
         Begin OptionButton Option1
            BackColor       =   &H00C0C0C0&
            Caption         =   "Person"
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Index           =   0
            Left            =   180
            TabIndex        =   16
            Top             =   300
            Value           =   -1  'True
            Width           =   1095
         End
         Begin OptionButton Option1
            BackColor       =   &H00C0C0C0&
            Caption         =   "Company"
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Index           =   1
            Left            =   180
            TabIndex        =   17
            Top             =   540
            Width           =   1155
         End
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   7
         Left            =   180
         TabIndex        =   8
         Top             =   2940
         Width           =   1455
      End
      Begin TextBox Text1
         Height          =   285
         Index           =   8
         Left            =   1680
         TabIndex        =   9
         Top             =   2940
         Width           =   1455
      End
      Begin CommandButton Command4
         Caption         =   "&Save Card"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Left            =   1800
         TabIndex        =   15
         Top             =   4140
         Width           =   1635
      End
      Begin Label LiveNum
         BackColor       =   &H00C0C0C0&
         Caption         =   "Live Records:"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   195
         Left            =   2580
         TabIndex        =   31
         Top             =   240
         Width           =   2175
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Reference"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   9
         Left            =   3180
         TabIndex        =   30
         Top             =   2700
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "First Name"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   195
         Index           =   0
         Left            =   180
         TabIndex        =   29
         Top             =   540
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Last Name"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   195
         Index           =   1
         Left            =   2340
         TabIndex        =   28
         Top             =   540
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Address"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   2
         Left            =   180
         TabIndex        =   27
         Top             =   1620
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "City"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   3
         Left            =   180
         TabIndex        =   26
         Top             =   2160
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "State"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   4
         Left            =   2880
         TabIndex        =   25
         Top             =   2160
         Width           =   495
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Zip Code"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   5
         Left            =   3660
         TabIndex        =   24
         Top             =   2160
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Company"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   195
         Index           =   6
         Left            =   180
         TabIndex        =   23
         Top             =   1080
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Voice"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   7
         Left            =   180
         TabIndex        =   22
         Top             =   2700
         Width           =   915
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Fax"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   8
         Left            =   1680
         TabIndex        =   21
         Top             =   2700
         Width           =   915
      End
      Begin Label CardNum
         BackColor       =   &H00C0C0C0&
         Caption         =   "Card: 0/0"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   195
         Left            =   180
         TabIndex        =   20
         Top             =   240
         Width           =   2175
      End
   End
   Begin Menu m_File
      Caption         =   "&File"
      Begin Menu m_InitDB
         Caption         =   "&Create Card Databases..."
      End
      Begin Menu m_Sep1
         Caption         =   "-"
      End
      Begin Menu m_Open
         Caption         =   "&Open Cards..."
      End
      Begin Menu m_Close
         Caption         =   "&Close Cards"
      End
      Begin Menu m_Sep2
         Caption         =   "-"
      End
      Begin Menu m_Quit
         Caption         =   "&Quit"
      End
   End
   Begin Menu mOther
      Caption         =   "&Other"
      Begin Menu mLockRecord
         Caption         =   "&Lock this record"
         Shortcut        =   ^L
      End
      Begin Menu mSep1
         Caption         =   "-"
      End
      Begin Menu mDelete
         Caption         =   "&Delete current record"
         Shortcut        =   ^D
      End
      Begin Menu mSepOther
         Caption         =   "-"
      End
      Begin Menu mReIndex
         Caption         =   "&ReIndex database"
      End
      Begin Menu mEditRefTbl
         Caption         =   "&Edit Reference Table"
      End
      Begin Menu mSepOther2
         Caption         =   "-"
      End
      Begin Menu mSevere
         Caption         =   "&SP Demo"
         Begin Menu mSevereLoad
            Caption         =   "Load list using SP API"
         End
         Begin Menu mNormalLoad
            Caption         =   "Load list using standard 'skips'"
         End
         Begin Menu SPSep
            Caption         =   "-"
         End
         Begin Menu mSPCount
            Caption         =   "Get COUNT- SP"
         End
      End
      Begin Menu mSep1121
         Caption         =   "-"
      End
      Begin Menu mBottom
         Caption         =   "&Bottom of index"
      End
      Begin Menu mTop
         Caption         =   "&Top of index"
      End
   End
   Begin Menu m_Test
      Caption         =   "&Test"
      Begin Menu m_AddXRnd
         Caption         =   "&Add X - Random..."
      End
      Begin Menu m_RplXRandom
         Caption         =   "&Replace X - Random..."
      End
   End
   Begin Menu mHelp
      Caption         =   "&Help"
      Begin Menu mAbout
         Caption         =   "&About..."
      End
   End
End
Option Explicit

' Change this to a location better for you...
Const CARDFILE = "C:\source\bcard"

Dim PersonDBHndl As Integer ' Handle to person db
Dim PersonCurIndex As Integer ' Current index selected
Dim PersonCurRec As Long      ' Record currently in use...
Dim PersonTotRecs As Long   ' total # of recs in person db



Dim curFile As String   ' Curretly open DB file name

' Take data from disply and store in tCard
Function bcFillData% (c As tCard)
    c.Person.fname = text1(0).Text
    c.Person.lname = text1(1).Text
    c.data.street = text1(2).Text
    c.data.city = text1(3).Text
    c.data.state = text1(4).Text
    c.data.zip = text1(5).Text

    c.company.cName = text1(6).Text


    c.ref.ref = Combo1.ListIndex



    c.data.voice = text1(7).Text
    c.data.fax = text1(8).Text



End Function

' take data from var and display it
Function bcShowData% (c As tCard)
    text1(0).Text = c.Person.fname
    text1(1).Text = c.Person.lname
    text1(2).Text = c.data.street
    text1(3).Text = c.data.city
    text1(4).Text = c.data.state
    text1(5).Text = c.data.zip

    text1(6).Text = c.company.cName
    ' since the 'random add' functions don't
    ' set this value properly -- we have to check
    ' for an error condition...
    On Error Resume Next
    Combo1.ListIndex = c.ref.ref
    On Error GoTo 0

    text1(7).Text = c.data.voice
    text1(8).Text = c.data.fax
    'Command4.Enabled = False
    'command3.Enabled = False

    ' Updates statistics at  the top of the screen...
    UpdateStats



End Function

Sub Command1_Click (Index As Integer)
    Dim PlusMinus As Integer
    Dim NextRec As Long
    Dim bcard As tCard

    ' Are They going FORWARD or BACKWARD
    If Index = 0 Then
        PlusMinus = 1   ' Next Record
    ElseIf Index = 1 Then
        PlusMinus = -1
    Else
        PlusMinus = 0   ' just force a re-display
    End If
    If PersonCurRec > 0 Then

        PersonCurRec = mfSkip(PersonCurRec, PlusMinus, TaskHndl, PersonDBHndl, PersonCurIndex)
        If PersonCurRec = MFSEEK_BOF Then
            Beep
            ' They tried to skip past the begining of the file.  Since we already
            ' overwrote the ptr to the previous record, we need to find out
            ' what the first record was...
            PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
        ElseIf PersonCurRec = MFSEEK_EOF Then
            Beep
            ' They tried to skip past the END of the file.  Since we already
            ' overwrote the ptr to the previous record, we need to find out
            ' what the first record was...
            PersonCurRec = mfBottom(TaskHndl, PersonDBHndl, PersonCurIndex)
        End If
        junk = mfRead(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)
    Else
        ' We end up here if it's an empty database
        PersonCurRec = 0
    End If

    If junk < 0 Then
        ' This shouldn't happen...
        MsgBox "Bad Read"
    End If
    cardnum.Caption = curFile + " " + Format$(PersonCurRec) + " of " + Format$(PersonTotRecs) + " cards"
    junk = bcShowData(bcard)

End Sub

' Find a record
Sub Command2_Click ()
    Dim jump$, code%, jumpto&, s$, jumpint%

    ' Which Index do they have active? (Order by box)
    If PersonCurIndex = 0 Then
        s = "Seek String for Last/First name"
    ElseIf PersonCurIndex = 1 Then
        s = "Seek String for Company"
    Else
        s = "Seek String for Reference #"
    End If
    jump = InputBox$(s, "Record")

    ' NOTE: ALL seeks are SOFT.  If you need an
    ' exact match, then assume if you fully specify
    ' a key, it will be an exact...
    If PersonCurIndex = 2 Then  ' search for a int...
        ' INTS/LONGS/<Specialized> data types are passed with the
        ' MFSEEKO structure.  Since STRINGS (mfseeks) don't pass well
        ' using the as ANY keyword, there is a special mfseeks.  This
        ' is only a problem in VB.  Any language that supports passing
        ' ptrs to data will work fine with mf.
        jumpint = Val(jump)
        PersonCurRec = mfSeekO(jumpint, code, TaskHndl, PersonDBHndl, PersonCurIndex)
    Else
         ' SHOULD be padded to the length of the key
         ' else, it will probably not seek correctly
         ' (NOTE: Any padding you use for character keys
         ' should be consistent so you won't have to have
         ' alot of routines to do the seeking...
         ' (NOTE: MF doesn't care if you OVERPAD something.  However, if you
         ' UNDERPAD something -- you could get a GPF.  This is just the nature of
         ' the C language )
        jump = jump + Pad(128, " ")
        PersonCurRec = mfSeekS(jump, code, TaskHndl, PersonDBHndl, PersonCurIndex)
    End If

    If PersonCurRec = MFSEEK_EOF Then
        MsgBox ("Search key was greater than any key in the database")
    Else
        If code = MFSEEK_EXACT_MATCH Then
            MsgBox ("Exact Match")
        Else ' code will equal 2...
            MsgBox ("Closest Match")
        End If
    End If


    ' will update display with current record
    Command1_Click -1

End Sub

Sub Command3_Click ()
' Add a new record
    Dim bcard As tCard

    junk = bcFillData(bcard)

    ' First, append a new record to the database.
    ' NOTE: ON APPENDS:
    ' PASS >>ONLY<< the DATA portion of the record.  Do NOT pass the
    ' key along with the record.
    PersonCurRec = mfAppendData(bcard.data, TaskHndl, PersonDBHndl)
    ' Now, we have a reference to the new record.  We should proably
    ' verify that it is a good # (not negative).
    If PersonCurRec > 0 Then

        ' The MFRW_ALL flag tells it to update ALL index fields.  If we want
        ' to enhance the SPEED and we know we have blank fields, then we
        ' could have specified a specific index to update...
        junki = mfWrite(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)
        If junki < 0 Then
            MsgBox "Error on write:" + Format$(junki)
        End If

        ' This will tell us how many records are now in the database
        ' The size of a record, and the number of index's
        Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
        junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)

        PersonTotRecs = vNumRecs

    Else
        If junkl < 0 Then
            MsgBox "Error on add: " + Format$(junkl)
        End If
    End If

    cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)
    LiveNum.Caption = "Live Records:" + Format$(vLiveRecs)

End Sub

Sub Command4_Click ()
' Re-write current record...
    Dim bcard As tCard
    If PersonCurRec > 0 Then
        ' General function to get TEXT fields into a structure
        junk = bcFillData(bcard)

        junkl = mfWrite(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)

        If junkl < 0 Then
            MsgBox "Error on write:" + Format$(junkl)
        End If
    Else
        MsgBox "Not a valid record to SAVE to"
    End If


End Sub

Sub Command5_Click ()
    ' To see the 'size' (# of bytes in the key) of a particular index, just add a button (called command5) and
    ' this will show you the 'size' of the active index...
    MsgBox "Index Size:" + Format$(mfInfoIndex(TaskHndl, PersonDBHndl, PersonCurIndex))

End Sub

Sub Form_Load ()
    mfBeginRun

    PersonDBHndl = -1

End Sub

Sub Form_Unload (Cancel As Integer)
    ' Will auto-close any open db's
    mfEndRun


End Sub

' Place some sample data in the Reference database
Sub LoadSampleData (file$)
    Dim ref As tReference

    refDBHndl = mfOpen(file, TaskHndl)
    ref.ref = 1
    ref.refsub = 0
    ref.name = "Stores"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 1
    ref.refsub = 1
    ref.name = "Pizza"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 1
    ref.refsub = 2
    ref.name = "Computer"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 1
    ref.refsub = 3
    ref.name = "Movies"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 2
    ref.refsub = 0
    ref.name = "Personal"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 2
    ref.refsub = 1
    ref.name = "Relatives"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    ref.ref = 2
    ref.refsub = 2
    ref.name = "Friends"
    junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

    junk = mfClose(refDBHndl, TaskHndl)

End Sub

Sub m_AddXRnd_Click ()
' Tests Adding X # of random cards to the database.
' This is mostly for data-verifaction/system stress test
' (Since we know the first thing you'll want to do is
' see if you can crash it, we left this in here...<g>)
' If you are going to compare the 'speed' of MF with
' this function, feel free.  We would like to offer
' the results, though, right now:
'
' We tested: 3 index's (2 characer, 1 integer... of same
'                       size)
' Clipper: (DOS)
'       Recs/Second: 5 with LOCK, UNLOCK, FLUSHing
' (however, we were totally amazed that taking out the 'flush' brought around 150 records/second)
' unfortunately, the records weren't 'REAL' records and it wasn't a REAL network... oh well)
'
' vxBase: Recs/Second: 15 with LOCK, UNLOCK, WRITE
'
' mf:   Generally, 20-30...

    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If
    Dim jump&, n&
    Dim c As tCard

    jump = Val(InputBox$("# of records to add?", "Add"))

    c.data.street = "<Test Data>"
    c.data.city = "<Test Data>"
    c.data.state = "<>"
    c.data.zip = "<Test>"
    c.data.voice = "<Test>"
    c.data.fax = "<Test>"
    Randomize

    screen.MousePointer = 11    ' Hourglass

    For n = 1 To jump

        c.Person.fname = Format$(Rnd)
        c.Person.lname = Format$(Rnd)
        c.company.cName = Format$(Rnd)
        c.ref.ref = Rnd * 32000

        PersonTotRecs = mfAppendData(c.data, TaskHndl, PersonDBHndl)

        ' NOTE: To see the 'effect' of INDEXING overhead (described in the
        ' Docs), comment out this line...and step back...<grin>
        junkl = mfWrite(PersonTotRecs, c, TaskHndl, PersonDBHndl, MFRW_ALL)

        If junkl < 0 Then
            MsgBox "Error on add:" + Format$(junkl)
        End If
        If Int(n / 10) = n / 10 Then
            cardnum.Caption = "Processed: " + Format$(n)
            cardnum.Refresh
        End If
        ' This creates, in effect, background processing...
        junk = DoEvents()

    Next n

    screen.MousePointer = 0    ' Default
    'PersonCurRec = PersonTotRecs
    cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)


End Sub

' Closing database...
Sub m_Close_Click ()
    m_Open.Enabled = True
    m_Close.Enabled = False
    gBox.Enabled = False

    junk = mfClose(TaskHndl, PersonDBHndl)
    junk = mfClose(TaskHndl, refDBHndl)
    PersonDBHndl = -1


End Sub

' This demostrates creating a database
Sub m_InitDB_Click ()
    Dim file$, recsize%
    Dim Person As tPerson
    Dim company As tCompany
    Dim ref As tref
    Dim bcard As tCard

    If PersonDBHndl <> -1 Then
        MsgBox "Close all databases before doing this..."
        Exit Sub
    End If


    file = InputBox$("Enter File Name (7 character max -- no extension)", "Create CardFile", CARDFILE)
    If Len(file) > 0 Then
        screen.MousePointer = PHOURGLASS

        ' CREATE CARD DATABASE

        ' Calculate the size of an individual records 'data'
        recsize = Len(bcard) - Len(Person) - Len(company) - Len(ref)

        ' Fill arrays with index parameters
        ' Note: we have 3 index's for this database
        ReDim indSize(0 To 2) As tintArray
        ReDim indType(0 To 2) As tintArray
        indSize(0).i = Len(Person)  ' Key 0 (index 0...)
        indSize(1).i = Len(company) ' Key 1
        indSize(2).i = Len(ref)     ' Key 2

            ' This tells mf the TYPE of the index
        indType(0).i = MFCOMP_CHARIC  ' CHAR key - case insensitive
        indType(1).i = 1001           ' UDK (user-defined key) - Sorts in 'reverse' order...
                                      ' (see mfUDK.c for example)
        indType(2).i = MFCOMP_INT     ' An integer key...

        If mfCreateDB(file, recsize, 3, indSize(0), indType(0)) < 0 Then
            MsgBox "Error creating card database"
        End If

        '**************************************
        ' CREATE REFERENCE DATABASE

        file = file + "r"
        ' Calculate the size of an individual records 'data'
        recsize = 25    ' size of the data portion of the record

        ' Fill arrays with index parameters
        ' Note: we have 1 index for this database
        ReDim indSize(0 To 0) As tintArray
        ReDim indType(0 To 0) As tintArray
        indSize(0).i = 4  ' length of 2 integer keys...

            ' This tells mf the TYPE of the index
        indType(0).i = MFCOMP_INT  ' Integer key

        If mfCreateDB(file, recsize, 1, indSize(0), indType(0)) > -1 Then
            ' Let's put some sample data into the REF database
            LoadSampleData file

            MsgBox "Databases Created Successfully"
        Else
            MsgBox "Error creating reference database"
        End If
        screen.MousePointer = PNORMAL

    End If

End Sub

' Demostrates opening a couple of databases
Sub m_Open_Click ()
    Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
    Dim file$

    file = InputBox$("Enter File Name", "Open CardFile", CARDFILE)
    If Len(file) > 0 Then
        ' Call the open routine with the TASKhndl we recieved
        ' when the application started...
        ' PersonDBHndl will be > -1 if it can open a file...
        PersonDBHndl = mfOpen(file, TaskHndl)
        refDBHndl = mfOpen(file + "r", TaskHndl)

        If PersonDBHndl > -1 Then
            curFile = file

            junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)
            PersonTotRecs = vNumRecs
            m_Open.Enabled = False
            m_Close.Enabled = True
            gBox.Enabled = True
            PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)

            ' Load the 'references' combo box
            load_refs Combo1




            Command1_Click -1   ' Force disply of top record...


        Else
            MsgBox "Error on open: " + Str$(PersonDBHndl)
        End If
    End If

End Sub

Sub m_Quit_Click ()
    Unload bCardREf
    Unload bcard

End Sub

Sub m_RplXRandom_Click ()
' Tests changing the key for X # of random cards to the database.
' This is mostly for data-verifaction/system stress test
' NOTE: Don't use this code as a SAMPLE!  IT won't work in the real world.

    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If


    Dim jump&, n&
    Dim c As tCard

    jump = Val(InputBox$("# of records to replace?", "Add"))

    c.data.street = "<Test Data>"
    c.data.city = "<Test Data>"
    c.data.state = "<>"
    c.data.zip = "<Test>"
    c.data.voice = "<Test>"
    c.data.fax = "<Test>"
    Randomize

    screen.MousePointer = 11    ' Hourglass

    For n = 1 To jump

        c.Person.fname = Format$(Rnd)
        c.Person.lname = Format$(Rnd)
        c.company.cName = Format$(Rnd)
        c.ref.ref = Rnd * 32000

        junkl = mfWrite(n + PersonCurRec, c, TaskHndl, PersonDBHndl, MFRW_ALL)

        If junkl < 0 Then
            MsgBox "Error on replace:" + Format$(junkl)
        End If
        If Int(n / 10) = n / 10 Then
            cardnum.Caption = "Processed: " + Format$(n)
            cardnum.Refresh
        End If


    Next n

    screen.MousePointer = 0    ' Default
    'PersonCurRec = PersonTotRecs
    cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)

End Sub

Sub mAbout_Click ()
    MsgBox "Business Cards  -- This application is freeware.  All source code may be used for any purpose you see fit.  However, the mf.BAS file is copyright 1993 by Carl Brown"
End Sub

Sub mBottom_Click ()
    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If

    PersonCurRec = mfBottom(TaskHndl, PersonDBHndl, PersonCurIndex)
    ' force refresh
    Command1_Click 3
End Sub

Sub mDelete_Click ()
    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If
    If PersonCurRec < 1 Then
        MsgBox "Move to a record before selecting this option..."
        Exit Sub
    End If

    ' Delete selected record
    junki = mfDelete(PersonCurRec, TaskHndl, PersonDBHndl)
    PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
    Command1_Click 2    ' update display
End Sub

Sub mEditRefTbl_Click ()
    bCardREf.Show
End Sub

Sub mLockRecord_Click ()

    ' In a real world app, you would probably 'enable'
    ' the edit controls so the user could change
    ' the record without worrying about someone
    ' overwriting their changes.
    If mfLock(PersonCurRec, TaskHndl, PersonDBHndl) = 0 Then
        MsgBox "Record Locked!"
        If mfUnLock(PersonCurRec, TaskHndl, PersonDBHndl) <> 0 Then
            MsgBox "Unable to unlock record!"
        End If
    Else
        MsgBox "Record already locked by another user!"
    End If


End Sub

' This demonstrates the difference in speed between the
' severe-performance functions in mf and the 'standard' performance
' functions in mf (and other databases...)
' NOTE:  This is JUST meant to give you a general idea...
Sub mNormalLoad_Click ()
    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If
    Dim hits&, MAX_HITS&, startTime As Variant, n%, startRec&, rCode%, skStr$

    MAX_HITS = 1000
    screen.MousePointer = PHOURGLASS
    startTime = Time
    ' NOTE:
    ' We MUST have a 'seek' string padded to AT LEAST the maximum length of
    ' the index we are about to seek into.  If we don't, MF MAY GPF on us
    ' because it will be trying to look at memory that could straddle a segment
    ' boundary.  Space(100) forces plenty of extra padding at the end of the seek string
    skStr = "0" + Space$(100)
    startRec = mfSeekS("0", rCode, TaskHndl, PersonDBHndl, 0)
    If startRec > 0 Then
        For n = 0 To MAX_HITS
            ' First off, in order to get a 'partial-key', we would have to 'read' each record to see if it matched
            ' but, the point of this demo is to show the difference in 'skips' vs. readlists...
            ' So, these two are not equal.  The readlist is actually even FASTER than this
            ' because readlist returns the actual 'matching' list...
            startRec = mfSkip(startRec, 1, TaskHndl, PersonDBHndl, 0)
            ' make sure we don't hit EOF
            If startRec < 1 Then
                Exit For
            End If

        Next n
    Else
        MsgBox "Unable to start processing because nothing 'matched' the starting position..."
    End If

    MsgBox "Elapsed time: " + Format$(Time - startTime) + "    # of (potential) records read: " + Format$(n)
    screen.MousePointer = PNORMAL

End Sub

' Demonstration of reindexing
Sub mReIndex_Click ()

    ' Make a 'form' that will supply screen updates
    ' The form actually contains the code to perform
    ' the reindexing  (see the Form_Load stuff...)
    junki = PersonDBHndl

    ' Since the form unloads in it's LOAD procedure,
    ' we need to trap the error...
    On Error Resume Next
    IndexForm.Show asmodal
    On Error GoTo 0
    If junki < 0 Then
        MsgBox "Reindexing failed!  Restart BCards..."
    End If

    PersonDBHndl = junki



End Sub

' Demonstrates using a 'severe-performance' function
' Use the 'Add X random records' (menu option)
' to add a bunch of records that will be retrieved by
' this function...
Sub mSevereLoad_Click ()

    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If
    Dim hits&, MAX_HITS&, startTime As Variant, TopRecord&

    MAX_HITS = 1000
    ReDim hitList(0 To MAX_HITS) As tLongArray
    ' This example reads UP TO 1000 records (in sequential order) that start with
    ' the character "0".  The THIRD parm (a '1') tells the read API call to only
    ' process the FIRST character in the index field.
    ' Since we are seeking on a STRING index, we must use the readListS api call...
    ' NOTE:  The reason we use the "0" as the example is:  If you use the random
    ' ADD functions (under TEST) alot of "0.xxxxxxxx" names get created...
    screen.MousePointer = PHOURGLASS    ' This is SO fast, you may not need this...<grin>
    startTime = Time
    hits = mfReadListS(0, "0", 1, hitList(0), MAX_HITS, TaskHndl, PersonDBHndl, 0)
    screen.MousePointer = PNORMAL
    MsgBox "Elapsed time: " + Format$(Time - startTime) + "    " + "# of records read: " + Format$(hits)

    ' Demos a 'continuation set' read.  e.g. lets say there are too many hits to
    ' load in RAM.  You would have to continue the process using a second read...
    ' This is here just to show 'HOW' it would be done.  This wont actually work unless you
    ' have over 1000 hits to retrieve.  If you would like to see it work, make sure you put
    ' over 1000 records in your database (or cut back on the 'MAX_HITS' value...)

    'hits = mfReadListS(hitList(MAX_HITS), "0", 1, hitList(0), MAX_HITS, TaskHndl, personDBHndl, 0)


    ' Demos a 'list' of sequential records.  If you just want the first '1000' records, and
    ' don't care about a particular 'key', use this.
    'ReDim hitList(0 To MAX_HITS) As tLongArray
    'TopRecord = mfTop(TaskHndl, personDBHndl, 0)
    'hits = mfReadListNull(TopRecord, 0&, -1, hitList(0), MAX_HITS, TaskHndl, personDBHndl, 0)

End Sub

' Demos using the readlist COUNT option
' See the mSevereLoad for more comments
Sub mSPCount_Click ()

    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If
    Dim hits&, startTime As Variant


    ReDim hitList(0 To 0) As tLongArray
    screen.MousePointer = PHOURGLASS    ' This is SO fast, you may not need this...<grin>
    startTime = Time
    hits = mfReadListS(0, "0", 1, hitList(0), MF_SP_COUNT, TaskHndl, PersonDBHndl, 0)
    screen.MousePointer = PNORMAL
    MsgBox "Elapsed time: " + Format$(Time - startTime) + "    " + "# of records matching filter: " + Format$(hits)


End Sub

Sub mTop_Click ()
    If PersonDBHndl = -1 Then
        MsgBox "Open a database before trying this..."
        Exit Sub
    End If

    PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
    ' force refresh
    Command1_Click 3

End Sub

Sub Option1_Click (Index As Integer)
    PersonCurIndex = Index
End Sub

Sub Text1_Change (Index As Integer)
    Command4.Enabled = True
    command3.Enabled = True
End Sub

' Displays database information
Sub UpdateStats ()
    Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
    junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)

    cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)
    LiveNum.Caption = "Live Records:" + Format$(vLiveRecs)

End Sub